home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pasprog.EXE / PTRSCR.PAS < prev    next >
Pascal/Delphi Source File  |  1980-01-10  |  2KB  |  100 lines
  1. {
  2. =+= Copyright 1993 By M. Murat DiCLE
  3. =+= Print Screen Manager
  4. }
  5.  
  6. {$M 4096,0,0}
  7. Uses Crt, Dos;
  8. Var
  9.    PrintScreen:Procedure;
  10.    P     :Pointer;
  11.    I     :Integer;
  12.    EkrMem:LongInt;
  13.    Busy  :Boolean;
  14.    Attr  :Byte;
  15.    X, Y  :Byte;
  16.    C     :Char;
  17.    FN    :String;
  18.    F     :File;
  19.  
  20. {$F+}
  21.  
  22. Procedure EkranAl;
  23. Begin
  24.    For I := 0 To 3999 Do
  25.        Mem[EkrMem:4000+I] := Mem[EkrMem:I]
  26. End;
  27.  
  28. Procedure EkranGetir;
  29. Begin
  30.    For I := 0 To 3999 Do
  31.        Mem[EkrMem:I] := Mem[EkrMem:4000+I]
  32. End;
  33. Procedure PrtScrManager; Interrupt;
  34. Begin
  35.    If Busy Then Exit;
  36.    Busy := TRUE;
  37.    Attr := TextAttr;
  38.    X := WhereX;
  39.    Y := WhereY;
  40.    { Ekran Baslangic adresi belirleniyor.}
  41.    If LastMode = 7 Then
  42.       EkrMem := $B000
  43.    Else
  44.       EkrMem := $B800;
  45.    EkranAl;
  46.    TextColor(0);
  47.    TextBackGround(7);
  48.    GotoXY(1, 25);
  49.    Write('1-BAS');
  50.    Write('2-SAKLA':12);
  51.    Write('3-ÿPTAL':12);
  52.    Write('PrtScr Manager (c) 1993 M.M.D.':40);
  53.    ClrEol;
  54.    Repeat
  55.       C := ReadKey
  56.    Until C In['1'..'3'];
  57.    EkranGetir;
  58.    Case C Of
  59.       '1' : Begin
  60.                InLine($9C);
  61.                PrintScreen
  62.             End;
  63.       '2' : Begin
  64.                GotoXY(1, 25);
  65.                Write('Dosya adì:');
  66.                ClrEol;
  67.                GotoXY(12, 25); ReadLn(FN);
  68.                EkranGetir;
  69.                If FN <> '' Then
  70.                   Begin
  71.                      Assign(F, FN);
  72.                      ReWrite(F, 1);
  73.                      BlockWrite(F, Mem[EkrMem:0], 4000);
  74.                      Close(F)
  75.                   End
  76.             End;
  77.    End;
  78.    TextAttr := Attr;
  79.    GotoXY(X, Y);
  80.    Busy := FALSE;
  81. End;
  82. {$F-}
  83.  
  84. Begin
  85.    WriteLn('=+= Print Screen Manager =+=');
  86.    GetIntVec(100, P);
  87.    If P <> Nil Then
  88.       Begin
  89.          WriteLn('Program zaten aktif halde!');
  90.          WriteLn('PRINT SCREEN tuƒuna basìnìz...'#7);
  91.          Halt
  92.       End;
  93.    SetIntVec(100, @PrtScrManager);
  94.    GetIntVec(5, @PrintScreen);
  95.    SetIntVec(5, @PrtScrManager);
  96.    WriteLn('Program aktif halde!');
  97.    WriteLn('PRINT SCREEN tuƒuna basìnìz...');
  98.    Busy := False;
  99.    Keep(0);
  100. End.